Info-Mac 4/Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso/Development/General/ViewIt™ 2.24 Shareware/FORTRAN Demo Projects/Absoft MacFortran II 3.2 Demos/vDemoAF.f

Text File | 1993-09-21 | 5KB | 146 lines

C NOTE: Read the "MPW Fortrans" section of "About Compilers"
C before compiling AF programs that use FaceWare modules.

C ViewIt 2.2 Demonstration Program
C ©FaceWare 1991-93. All Rights Reserved.

    GLOBAL DEFINE
    include "Types.inc"
    include "QuickDraw.inc"
    include "Controls.inc"
    include "Events.inc"
    include "OSUtils.inc"
    include "OSEvents.inc"
    include "SegLoad.inc"
    include "Files.inc"
    include "Resources.inc"
    include "FaceStorAF.inc"
    END

    include "FaceProcAF.inc"

      PROGRAM vDemoAF
    implicit none
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    structure /DataRec/
      integer*2 myInteger
      real*4 myReal
      character*100 myString
      integer*4 myFlags
    end structure
    record/DataRec/myRec
    real*4 theReal,delta
    logical*4 helpShown
    integer*2 myList
    integer*4 myPtr,oldTicks,newTicks
    integer*4 OverProc
    pascal external OverProc

    myRec.myInteger = 0
    myRec.myReal = 6.2
    myRec.myString = 'Hello'
    myRec.myFlags = 10
    myList = 2
    oldTicks = 0
    theReal = 6.0

C Initialize FaceIt
      fRec.uName = 'vDemo.Rsrc'
      call FaceIt(0,DoInit,0,0,0,0)

C Open Modeless Window using FWND 1000
    call FaceIt(0,NewWnd,1000,1,0,0)

      do while (.true.)
        call FaceIt(0,DoLoop,0,0,0,0)
C Standard "About" Menu Item Selection
      if ((fRec.uMenuID == 101).and.(fRec.uMenuItem == 1)) then
        fRec.uString = 'Demonstration of the use of ViewIt'
     +//char(13)//'windows in a FaceIt-based program.'
        call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
C Hit in Modeless Window's "Open Modal" Button
      else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 2)) then
        call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
        do while (.true.)
          call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
        if (fRec.wcHit == -1) then        !Hit in Close Box
          exit
        else if (fRec.wcHit == 1) then    !Hit in "Open Nested"
          myPtr = %loc(myRec)
          call FaceIt(0,NewWnd,1002,0,110,myPtr)!Open Nested Modal
          call FaceIt(0,GetCtl,1002,0,3,3)    !Link Scrollable List
          call FaceIt(0,LnkCtl,fRec.cControl,%loc(myList),2,0)
          call FaceIt(0,GetCtl,1002,0,2,3)      !Set Override Proc
          call FaceIt(0,OvrCtl,fRec.cControl,OverProc,0,0)
          call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
          helpShown = .false.
          do while (.true.)
            call FaceIt(0,MdlWnd,1002,-2,0,0) !Process Modal Events
            if (fRec.uMenuID == 0) then       !No Message
              newTicks = TickCount()
            if (newTicks > oldTicks + 60) then
              oldTicks = newTicks
              call FaceIt(0,GetCtl,1002,0,2,8)
              call SetCtlValue(%val4(fRec.cControl),
     +            %val2(mod(fRec.cValue,4) + 1))
            end if
            else if (fRec.wvHit == 1) then      !Hit in View #1
              if (fRec.wcHit == 1) then      !Hit in "OK" Button
              exit
            else if (fRec.wcHit == 2) then  !Hit in "Show/Hide"
              if (helpShown) then
                call FaceIt(0,ShoCtl,0,0,-3,2)  !Hide v3, Show v2
                helpShown = .false.
              else
                call FaceIt(0,ShoCtl,0,0,-2,3)  !Hide v2, Show v3
                helpShown = .true.
              end if
            end if
            else if (fRec.wvHit == 2) then    !Hit in View #2
              if ((fRec.wcHit == 6).or.(fRec.wcHit == 7)) then
              call FaceIt(0,GetCtl,1002,0,2,int(fRec.wcHit))
              delta = 0.001 * (fRec.cMin - 2)
              myRec.myReal = myRec.myReal + delta
              call FaceIt(0,SetVal,0,0,2,2)
              call Delay(%val4(5),fRec.uI4)
            end if
            end if
          end do
          call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
          call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
        end if
        end do
        call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
C Hit in Modeless Window's "Why ViewIt?" Button
      else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 3)) then
        call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
        call FaceIt(0,SetVal,1003,0,0,0)
        do while (.true.)
          call FaceIt(0,MdlWnd,1003,0,0,0)
        if (fRec.wcHit == 1) exit
        end do
        call FaceIt(0,GetVal,1003,0,0,0)
        call FaceIt(0,EndWnd,1003,0,0,0)
      end if
      end do
      end

C NOTE: Use of a procedure like "OverProc" that is called by ViewIt
C requires that it be compiled with the "-k" option set.  See your
C MacFortran II manual for more info about the "-k" compiler option.
    PASCAL SUBROUTINE OverProc(thePtr)
    value thePtr
    implicit none
    integer*4 JumpIt,thePtr
    inline (JumpIt = /z'2257',z'2051',z'4e90'/)
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    if (fRec.uCommand == 264) then    !a key down message?
      if (fRec.uParam(1) == 32) then    !SPACE key pressed?
        fRec.uParam(1) = 95            !convert to UNDERLINE
      end if
    end if
    call JumpIt(%val4(thePtr))        !pass message to driver
    end